home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / games / kids / fouryrs.zoo / mirror.lst < prev    next >
File List  |  1993-02-21  |  2KB  |  101 lines
  1. ' mirror.gfa
  2. ' developed by Seymour Shlien
  3. ' 624 Courtenay Avenue
  4. ' Ottawa, Ontario
  5. ' Canada, K2A 3B5
  6. '
  7. ' The program and sources are public domain
  8. DIM deskcolors%(16)
  9. DIM xbs_files$(30)
  10. @get_deskcolors
  11. @dir_xbs_files
  12. @read_sound
  13. @dosound
  14. wid%=2
  15. hit%=2
  16. rez%=XBIOS(4)
  17. IF rez%<>0
  18.   ALERT 3," Please switch to | low resolution! ",1,"Oops",b%
  19.   STOP
  20. ENDIF
  21. @color_bar
  22. DEFFILL 2
  23. REPEAT
  24.   IF MOUSEK=1
  25.     IF MOUSEY>20
  26.       PBOX MOUSEX,MOUSEY,MOUSEX+wid%,MOUSEY+hit%
  27.       PBOX 320-MOUSEX,MOUSEY,320-MOUSEX+wid%,MOUSEY+hit%
  28.       PBOX MOUSEX,220-MOUSEY,MOUSEX+wid%,220-MOUSEY+hit%
  29.       PBOX 320-MOUSEX,220-MOUSEY,320-MOUSEX+wid%,220-MOUSEY+hit%
  30.     ELSE IF MOUSEX<180
  31.       DEFFILL MOUSEX/20
  32.     ELSE IF MOUSEX<230
  33.       DEFFILL 8
  34.       PBOX 0,20,319,199
  35.     ENDIF
  36.   ENDIF
  37. UNTIL ((MOUSEX>230) AND (MOUSEY<20) AND (MOUSEK=1))
  38. restore_deskcolors
  39. > PROCEDURE color_bar
  40.   VSETCOLOR 1,15,0,0
  41.   VSETCOLOR 2,0,15,0
  42.   VSETCOLOR 3,0,0,15
  43.   VSETCOLOR 4,15,15,0
  44.   VSETCOLOR 5,0,15,15
  45.   VSETCOLOR 6,15,0,15
  46.   VSETCOLOR 7,15,15,15
  47.   VSETCOLOR 8,0,0,0
  48.   CLS
  49.   FOR i=1 TO 8
  50.     DEFFILL i
  51.     PBOX i*20,8,(i+1)*20,16
  52.   NEXT i
  53.   DEFTEXT 8
  54.   TEXT 184,14,"CLEAR"
  55.   TEXT 230,14,"QUIT"
  56.   DEFFILL 8
  57.   PBOX 0,20,319,199
  58.   DEFMOUSE 0
  59. RETURN
  60. > PROCEDURE get_deskcolors
  61.   LOCAL i%
  62.   FOR i%=0 TO 15
  63.     deskcolors%(i%)=XBIOS(7,i%,-1)
  64.   NEXT i%
  65. RETURN
  66. > PROCEDURE restore_deskcolors
  67.   LOCAL i%
  68.   FOR i%=0 TO 15
  69.     SETCOLOR i%,deskcolors%(i%)
  70.   NEXT i%
  71. RETURN
  72. > PROCEDURE dir_xbs_files
  73.   number_of_xbs_files%=0
  74.   ~FSETDTA(BASEPAGE+128)
  75.   e%=FSFIRST("\*.XBS",-1)
  76.   DO UNTIL e%
  77.     xbs_files$(number_of_xbs_files%)=CHAR{BASEPAGE+158}
  78.     e%=FSNEXT()
  79.     INC number_of_xbs_files%
  80.   LOOP
  81. RETURN
  82. > PROCEDURE read_sound
  83.   LOCAL a%,i%
  84.   IF number_of_xbs_files%>0
  85.     i%=RANDOM(number_of_xbs_files%)
  86.     OPEN "i",#1,xbs_files$(i%)
  87.     a%=LOF(#1)
  88.     DIM music_data&(a%/2)
  89.     BLOAD xbs_files$(i%),VARPTR(music_data&(0))
  90.     CLOSE #1
  91.   ENDIF
  92. RETURN
  93. > PROCEDURE dosound
  94.   LOCAL i%
  95.   IF number_of_xbs_files%>0
  96.     '  SPOKE &H484,PEEK(&H484) AND NOT 1
  97.     addr%=V:music_data&(0)
  98.     ~XBIOS(32,L:addr%)
  99.   ENDIF
  100. RETURN
  101.